home *** CD-ROM | disk | FTP | other *** search
/ BMUG Revelations / BMUG Revelations.toast / Programming / Programming Languages / UCB Logo 3.0 / CSLS / ttt < prev   
Text File  |  1992-09-04  |  4KB  |  224 lines

  1. TO BEST :LIST
  2. OP BEST1 FIRST :LIST LAST :LIST :YOURWINS
  3. END
  4.  
  5. TO BEST1 :BOX1 :BOX2 :WINS
  6. IF EMPTYP :WINS [OP :BOX2]
  7. IF MEMBERP :BOX1 FIRST :WINS [OP BEST2 :BOX1 :BOX2 BF :WINS]
  8. OP BEST1 :BOX1 :BOX2 BF :WINS
  9. END
  10.  
  11. TO BEST2 :BOX1 :BOX2 :WINS
  12. IF EMPTYP :WINS [OP :BOX2]
  13. IF MEMBERP :BOX1 FIRST :WINS [OP :BOX1]
  14. OP BEST2 :BOX1 :BOX2 BF :WINS
  15. END
  16.  
  17. TO BOARD
  18. CS HT
  19. DRAWLINE [-20 -50] 0 120
  20. DRAWLINE [20 -50] 0 120
  21. DRAWLINE [-60 -10] 90 120
  22. DRAWLINE [-60 30] 90 120
  23. END
  24.  
  25. TO CHOOSE :SIDE
  26. PR :SIDE
  27. IF EQUALP :SIDE "X [CHOOSEX STOP]
  28. IF EQUALP :SIDE "O [CHOOSEO STOP]
  29. TYPE [HUH? TYPE X OR O:]
  30. CHOOSE RC
  31. END
  32.  
  33. TO CHOOSEO
  34. MAKE "ME "X
  35. MAKE "YOU "O
  36. END
  37.  
  38. TO CHOOSEX
  39. MAKE "ME "O
  40. MAKE "YOU "X
  41. END
  42.  
  43. TO DRAW :WHO :BOX
  44. RUN SE WORD "DRAW :WHO :BOX
  45. END
  46.  
  47. TO DRAWLINE :POS :HEAD :LEN
  48. PU
  49. SETPOS :POS
  50. SETH :HEAD
  51. PD
  52. FD :LEN
  53. END
  54.  
  55. TO DRAWO :BOX
  56. MOVE :BOX
  57. O
  58. END
  59.  
  60. TO DRAWX :BOX
  61. MOVE :BOX
  62. X
  63. END
  64.  
  65. TO FORK1 :LIST
  66. IF EMPTYP :LIST [OP "FALSE]
  67. IF THING WORD "HIT FIRST :LIST [MEPLAY FIRST :LIST OP "TRUE]
  68. MAKE WORD "HIT FIRST :LIST "TRUE
  69. OP FORK1 BF :LIST
  70. END
  71.  
  72. TO FORKMOVE :LISTS
  73. IF EMPTYP :LISTS [OP "FALSE]
  74. IF FORK1 FIRST :LISTS [OP "TRUE]
  75. OP FORKMOVE BF :LISTS
  76. END
  77.  
  78. TO GETMOVE
  79. TYPE [YOUR MOVE:]
  80. OP TRYMOVE RC
  81. END
  82.  
  83. TO INIT
  84. MAKE "FREE [5 1 3 7 9 2 4 6 8]
  85. MAKE "MYWINS []
  86. MAKE "YOURWINS []
  87. MAKE "FREEWINS [[1 5 9] [3 5 7] [1 2 3] [4 5 6] [7 8 9]     ~
  88.                 [1 4 7] [2 5 8] [3 6 9]]
  89. PR [DO YOU WANT TO PLAY FIRST (X)]
  90. TYPE [OR SECOND (O)? TYPE X OR O:]
  91. CHOOSE RC
  92. PR [FOR EACH MOVE, TYPE DIGIT 1-9.]
  93. END
  94.  
  95. TO MEPLAY :BOX
  96. DRAW :ME :BOX
  97. PLAY :BOX "MYWINS "YOURWINS
  98. END
  99.  
  100. TO MOVE :BOX
  101. PU
  102. SETPOS THING WORD "BOX :BOX
  103. END
  104.  
  105. TO O
  106. SETH 0
  107. PU
  108. FD 8
  109. PD
  110. REPEAT 8 [FD 12 RT 45]
  111. END
  112.  
  113. TO PICKMOVE
  114. LOCAL [HIT1 HIT2 HIT3 HIT4 HIT5 HIT6 HIT7 HIT8 HIT9]
  115. IF WINMOVE SINGLE :MYWINS [OP "TRUE]
  116. IF WINMOVE SINGLE :YOURWINS [OP "FALSE]
  117. ZEROHITS :FREE
  118. IF FORKMOVE :MYWINS [OP "FALSE]
  119. IF NOT EMPTYP :MYWINS [MEPLAY BEST FIRST :MYWINS OP "FALSE]
  120. MEPLAY FIRST :FREE
  121. OP "FALSE
  122. END
  123.  
  124. TO PLAY :BOX :PLAYER :OTHER
  125. MAKE "FREE REMOVE :BOX :FREE
  126. MAKE :PLAYER SHORTEN :BOX THING :PLAYER
  127. MAKE :OTHER STRIP :BOX THING :OTHER
  128. MAKE "FREEWINS UNFREE :BOX :PLAYER :FREEWINS
  129. END
  130.  
  131. TO PLAYLOOP
  132. IF EMPTYP :FREE [PR [TIE!] STOP]
  133. IF GETMOVE [PR [YOU WIN!] STOP]
  134. IF EMPTYP :FREE [PR [TIE!] STOP]
  135. IF PICKMOVE [PR [I WIN!] STOP]
  136. PLAYLOOP
  137. END
  138.  
  139. TO REMOVE :THING :LIST
  140. IF EMPTYP :LIST [OP []]
  141. IF EQUALP :THING FIRST :LIST [OP BF :LIST]
  142. OP FPUT FIRST :LIST REMOVE :THING BF :LIST
  143. END
  144.  
  145. TO SHORTEN :BOX :LIST
  146. IF EMPTYP :LIST [OP []]
  147. IF MEMBERP :BOX FIRST :LIST     ~
  148.    [OP FPUT REMOVE :BOX FIRST :LIST SHORTEN :BOX BF :LIST]
  149. OP FPUT FIRST :LIST SHORTEN :BOX BF :LIST
  150. END
  151.  
  152. TO SINGLE :LIST
  153. IF EMPTYP :LIST [OP []]
  154. IF EMPTYP BF FIRST :LIST [OP FIRST FIRST :LIST]
  155. OP SINGLE BF :LIST
  156. END
  157.  
  158. TO STRIP :BOX :LIST
  159. IF EMPTYP :LIST [OP []]
  160. IF MEMBERP :BOX FIRST :LIST [OP STRIP :BOX BF :LIST]
  161. OP FPUT FIRST :LIST STRIP :BOX BF :LIST
  162. END
  163.  
  164. TO TRYMOVE :BOX
  165. PR :BOX
  166. IF NOT MEMBERP :BOX :FREE [PR [NOT A VALID MOVE.] OP GETMOVE]
  167. YOUPLAY :BOX
  168. OP MEMBERP [] :YOURWINS
  169. END
  170.  
  171. TO TTT
  172. LOCAL [MYWINS YOURWINS FREEWINS FREE ME YOU]
  173. SS
  174. BOARD
  175. INIT
  176. IF EQUALP :ME "X [MEPLAY 5]
  177. PLAYLOOP
  178. END
  179.  
  180. TO UNFREE :BOX :PLAYER :LIST
  181. IF EMPTYP :LIST [OP []]
  182. IF MEMBERP :BOX FIRST :LIST ~
  183.    [MAKE :PLAYER FPUT REMOVE :BOX FIRST :LIST THING :PLAYER ~
  184.     OP UNFREE :BOX :PLAYER BF :LIST]
  185. OP FPUT FIRST :LIST UNFREE :BOX :PLAYER BF :LIST
  186. END
  187.  
  188. TO WINMOVE :MOVE
  189. IF EMPTYP :MOVE [OP "FALSE]
  190. MEPLAY :MOVE
  191. OP "TRUE
  192. END
  193.  
  194. TO X
  195. SETH 45
  196. PD
  197. FD 40
  198. BK 20
  199. RT 90
  200. FD 20
  201. BK 40
  202. END
  203.  
  204. TO YOUPLAY :BOX
  205. DRAW :YOU :BOX
  206. PLAY :BOX "YOURWINS "MYWINS
  207. END
  208.  
  209. TO ZEROHITS :LIST
  210. IF EMPTYP :LIST [STOP]
  211. MAKE WORD "HIT FIRST :LIST "FALSE
  212. ZEROHITS BF :LIST
  213. END
  214.  
  215. MAKE "BOX1 [-54 36]
  216. MAKE "BOX2 [-14 36]
  217. MAKE "BOX3 [26 36]
  218. MAKE "BOX4 [-54 -4]
  219. MAKE "BOX5 [-14 -4]
  220. MAKE "BOX6 [26 -4]
  221. MAKE "BOX7 [-54 -44]
  222. MAKE "BOX8 [-14 -44]
  223. MAKE "BOX9 [26 -44]
  224.